home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / DD3BETA1.ZIP / PACK1.PRG / TMP / DD3GRAPH.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-15  |  5.3 KB  |  256 lines

  1. unit dd3graph;
  2. {Door Driver/3 Generic Graphics Routines}
  3. interface
  4.   uses dd3ansi,dd3comm,dd3str,dd3time,dd3ini,dd3drop;
  5. const
  6.    ASCII = 1;
  7.    ANSI  = 2;
  8.    AVT   = 3; {Not Supported Locally}
  9.    RIP   = 4; {Not Supported Locally}
  10.    MAX   = 5; {Not Supported Locally}
  11. var
  12.   graphics : byte;
  13.   textb,textf      : byte;
  14. procedure sgoto_xy(x,y : byte);
  15. procedure sclrscr;
  16. procedure sclreol;
  17. procedure swritexy(x,y : word; s:string);
  18. procedure set_foreground(f : word);
  19. procedure set_background(b : word);
  20. procedure set_color(f,b : word);
  21. procedure displayfile(filen : string);
  22. procedure gwrite(s : string);
  23. procedure dropmessage;
  24. {function detectgraphics : byte;}
  25.  
  26. implementation
  27.  
  28. uses dd3,crt;
  29.  
  30.  
  31. (*Function RipDetect: boolean;
  32. var
  33.   i,j,k : integer;
  34.   a : char;
  35.   s : string;
  36.   RipYes : boolean;
  37. begin
  38.  RipYes := false;
  39.  If local then
  40.    begin
  41.      RipDetect := RipYes;
  42.      exit;
  43.    end;
  44.  gwrite(#27+'[0;30m'+#13+#10);
  45.  writeln;
  46.  writeln('Checking for RIP');
  47.  gwrite(#27'[!');
  48.  delay(222);
  49.  s := '';
  50.  i := 0;
  51.  j := 0;
  52.  charorigin:=localchar;
  53.  repeat;
  54.    a:=chr(0);
  55.    inc(i);
  56.   If (Not AsyncCarrierPresent) then DropMessage;
  57.   a := sread_char;
  58.   if (a<>chr(0)) then
  59.     begin
  60.       s := s+a;
  61.       inc(j);
  62.     end
  63.   else
  64.      begin
  65.        If (i mod 50 = 0) then
  66.          GiveSlice;
  67.      end;
  68.   delay(2);
  69.   until (i>666) or (j>13);
  70.   If Copy(s,1,3) = 'RIP' then
  71.     begin
  72.       RipYes := true;
  73.       writeln('Rip Detected');
  74.     end;
  75.  RipDetect := RipYes;
  76.  Swriteln('');
  77. end;
  78.  
  79. function detectgraphics : byte;
  80. var
  81.  temp : string[60];
  82.  cnt  : byte;
  83.  ch   : char;
  84.  detectansi : boolean;
  85. begin
  86. if local then begin {Check for Local}
  87.   detectgraphics := ANSI;
  88.   exit;
  89. end;
  90.   gwrite(#27+'[6n');
  91.   repeat
  92.     ch := sread_char;
  93.     if (ch in [#27,'0'..'9','[','H']) then detectansi := true;
  94.   until (skeypressed = false);
  95.   if detectansi then writeln('ANSI Graphics Detected');
  96.   if detectansi then graphics := ANSI;
  97.   if RipDetect then graphics  := RIP;
  98. end;*)
  99.  
  100. procedure dropmessage;
  101. begin
  102. writeln('');
  103. writeln('');
  104. writeln('User Has Dropped Carrier - Returning to BBS');
  105. freeini;
  106. deletedroplist;
  107. halt;
  108. end;
  109.  
  110. procedure sgoto_xy(x,y : byte);
  111. begin
  112.  case graphics of
  113.    ASCII : ; {Non Defined}
  114.    ANSI  : gwrite(#27+'['+int_to_str(y)+';'+int_to_str(x)+'f');
  115.    AVT   : ;
  116.    RIP   : ;
  117.    MAX   : ;
  118.  end;{case}
  119. end;
  120. procedure sclrscr;
  121. begin
  122.  case graphics of
  123.    ASCII : gwrite(#12);{TTY}
  124.    ANSI  : gwrite(#27'[2J');
  125.    AVT   : ;
  126.    RIP   : ;
  127.    MAX   : ;
  128.  end;{case}
  129. end;
  130. procedure sclreol;
  131. begin
  132.   case graphics of
  133.    ASCII : ; {Non Defined}
  134.    ANSI  : gwrite(#27'[K');
  135.    AVT   : ;
  136.    RIP   : ;
  137.    MAX   : ;
  138.  end;{case}
  139. end;
  140. procedure swritexy(x,y : word; s:string);
  141. begin
  142.   case graphics of
  143.    ASCII : gwrite(s); {Cursor Positioning Not Availible}
  144.    ANSI  : begin
  145.               sgoto_xy(x,y);
  146.               gwrite(s);
  147.            end;
  148.    AVT   : ;
  149.    RIP   : ;
  150.    MAX   : ;
  151.  end;{case}
  152. end;
  153. procedure set_foreground(f : word);
  154. const
  155.   ansif: array[0..7] of string[2] = ('30','34','32','36','31','35','33','37');
  156. var
  157.  s : string;
  158. begin
  159. textf := f;
  160. case graphics of
  161.    ASCII : textcolor(7);
  162.    ANSI  : begin
  163.  
  164.             s := #27'[';
  165.             if (f > 7) and (f < 16) then s := s+';1';
  166.             if (f > 15) and (f <32) then s := s+';5';
  167.             if f > 15 then dec(f,16);
  168.             if f > 7 then dec(f,8);
  169.             s := s + ';'+ansif[f]+'m';
  170.             gwrite(s);
  171.            end;
  172.    AVT   : ;
  173.    RIP   : ;
  174.    MAX   : ;
  175. end;{case}
  176. end;
  177.  
  178. procedure set_background(b :word);
  179. const
  180.  colorb: array[0..7] of integer = (40,44,42,46,41,45,43,47);
  181. begin;
  182. case graphics of
  183.   ASCII  : textbackground(0);
  184.   ANSI   : begin
  185.              if b > 7 then exit;
  186.              if (textf=7) and (b=0) then
  187.                 gwrite(#27+'[0m')
  188.              else
  189.              gwrite(#27+'['+int_to_str(colorb[b])+'m');
  190.              textb := b;
  191.             end;
  192.   AVT     : ;
  193.   MAX     : ;
  194.   RIP     : ;
  195. end; {case}
  196. end;
  197. procedure set_color(f,b : word);
  198. begin
  199.   textf := f;
  200.   textb := b;
  201.   set_foreground(f);
  202.   set_background(b);
  203. end;
  204. procedure gwrite(s : string);
  205. begin
  206. if not local then if asynccarrierpresent = false then dropmessage;
  207.   case graphics of
  208.    ASCII : begin
  209.              write(s);
  210.              if not local then asyncsendstr(s);
  211.            end;
  212.    ANSI  : begin
  213.              ansi_write_str(s);
  214.              if not local then asyncsendstr(s);
  215.            end;
  216.    AVT   : begin
  217.             write(s);
  218.             if not local then asyncsendstr(S);
  219.            end;
  220.    RIP   : begin
  221.               write(s);
  222.               if not local then asyncsendstr(s);
  223.            end;
  224.    MAX   : begin
  225.               write(s);
  226.               if not local then asyncsendstr(s);
  227.            end;
  228.    else   begin
  229.               write(s);
  230.               if not local then asyncsendstr(s);
  231.           end;
  232.  end;{case}
  233. giveslice;
  234. end;
  235.  
  236. procedure displayfile(filen : string);
  237. var f : text;
  238. temp : string;
  239. begin
  240. assign(f,filen);
  241. {$I-}reset(f);{$I+}
  242.  if ioresult = 0 then begin
  243.   while not eof(F) do
  244.        begin
  245.         readln(f,temp);
  246.         gwrite(temp+#13#10);
  247.        end;{While}
  248.   close(f);
  249.  end;{ioresult}
  250. set_color(textf,textb);
  251. end;
  252.  
  253. begin
  254.  textf    := 7; {For Ground}
  255.  textb    := 0; {Background}
  256. end.